home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / UTILFILE / RUN.LZH / RUN.PAS < prev   
Pascal/Delphi Source File  |  1988-04-11  |  12KB  |  355 lines
  1. {$R-,S+,I-,D-,T-,F-,V+,B-,N-,L+ }
  2. {$M 10000,0,0}
  3.  
  4. Program Run;
  5.  
  6. Uses DOS;
  7.  
  8. { Useful for running a program from anywhere on a hard disk.         }
  9. { Some programs do not work properly with the PATH command, which    }
  10. { DOS uses to locate programs, so this one first changes to the      }
  11. { directory where the program is located, and then runs the program. }
  12.  
  13. { Syntax:  RUN program          --  finds program and runs it        }
  14. {          RUN d:program        --  d: is the drive name             }
  15. {          RUN \subdir\program  --  \subdir\ is a subdirectory       }
  16. {          RUN program.exe      --  run the program with .EXE extension }
  17. {          RUN program cmdline  --  run the program and pass the     }
  18. {                                   cmdline to the program, as well  }
  19.  
  20. { Searches for the first occurrence of a program with the given name.}
  21. { If RUN finds the program with an extension of .COM, .EXE, or .BAT, }
  22. { it runs it.  When that program is complete, then RUN changes the   }
  23. { subdirectory back to the original one.                             }
  24.  
  25. { If there are several programs with the same name, but different    }
  26. { extensions, RUN chooses which one to run in the same order as      }
  27. { MS-DOS does:                                                       }
  28. {   1.  .COM                                                         }
  29. {   2.  .EXE                                                         }
  30. {   3.  .BAT                                                         }
  31.  
  32. { You may specify the drive, or even the subdirectory where RUN      }
  33. { should try to find your program.                                   }
  34.  
  35. { DO NOT attempt to run Terminate-and-Stay-Resident (TSR) programs.  }
  36. { If you do, both RUN and the program remain in memory until you     }
  37. { restart the computer.                                              }
  38.  
  39. { Returns an ERRORLEVEL code if RUN is unable to run the program.    }
  40. {   0: RUN ran the program successfully                              }
  41. {   1: RUN could not find the program                                }
  42. {   2: RUN could not find COMMAND.COM                                }
  43. {   3: Directories nested too deeply                                 }
  44.  
  45. Var
  46.   FoundCOM,             { located a program with extension of .COM   }
  47.   FoundEXE,             { located a program with extension of .EXE   }
  48.   FoundBAT  : Boolean;  { located a program with extension of .BAT   }
  49.  
  50.   COMloc,               { location of program with extension of .COM }
  51.   EXEloc,               { location of program with extension of .EXE }
  52.   BATloc    : String;   { location of program with extension of .BAT }
  53.  
  54.   CurDir    : String;   { current drive and subdirectory             }
  55.   Ext,                  { specified file extension                   }
  56.   Drive,                { specified drive name on program            }
  57.   Subdir,               { specified subdirectory on program          }
  58.   ProgName,             { program name                               }
  59.   TempName,             { temporary program name                     }
  60.   Command   : String;   { additional command line to pass to program }
  61.  
  62.   i         : Integer;  { always nice to have a variable around      }
  63.   oldexitproc:Pointer;  { save the runtime error procedure's address }
  64.  
  65. { ----------------------------------------------- Exists ----------- }
  66. { Determines if the file exists }
  67.  
  68. function Exists( FileName : String ) : Boolean;
  69.  
  70. var
  71.   SR : SearchRec;
  72.  
  73. begin
  74.  
  75.   FindFirst(FileName, ReadOnly + Hidden + SysFile, SR);
  76.   Exists := (DosError = 0) and (Pos('?', FileName) = 0) and
  77.             (Pos('*', FileName) = 0);
  78. end; { Exists }
  79.  
  80. { ----------------------------------------------- Caps ------------- }
  81. { Returns the string in UPPER CASE }
  82.  
  83. function Caps( capstr : string ): string;
  84.  
  85. var i : word;
  86.  
  87. begin { Caps }
  88.  
  89.   for i := 1 to Length( capstr ) do capstr[i] := UpCase( capstr[i] );
  90.   Caps := capstr;
  91.  
  92. end;  { Caps }
  93.  
  94. { ----------------------------------------------- Search ---------------- }
  95. { Returns path to searchfile }
  96.  
  97. function Search( subdir, searchfile : String ): String;
  98.  
  99. var
  100.   SR : SearchRec;
  101.   Ext: String[4];
  102.  
  103. begin { Search }
  104.  
  105.   { init Search }
  106.   Search := '';
  107.  
  108.   { add \ to the directory }
  109.   subdir := subdir + '\';
  110.  
  111.   { find any files in this subdir }
  112.   FindFirst( subdir+searchfile,ReadOnly + Hidden + SysFile,SR );
  113.  
  114.   While DosError = 0 do begin
  115.     { get extension }
  116.     Ext := Copy( SR.name, pos( '.', SR.name ), 4 );
  117.  
  118.     If NOT FoundCOM AND (Ext = '.COM') then begin
  119.       COMloc := subdir;
  120.       FoundCOM := TRUE;
  121.       end
  122.     Else If NOT FoundEXE AND (Ext = '.EXE') then begin
  123.       EXEloc := subdir;
  124.       FoundEXE := TRUE;
  125.       end
  126.     Else If NOT FoundBAT AND (Ext = '.BAT') then begin
  127.       BATloc := subdir;
  128.       FoundBAT := TRUE;
  129.     End;
  130.  
  131.     FindNext( SR );
  132.   end;
  133.  
  134.   { find any directories in this subdir and recursively call Search }
  135.   FindFirst( subdir+'*.*',Directory,SR );
  136.   While DosError = 0 do begin
  137.     If (SR.name <> '.') and (SR.name <> '..') and (SR.attr AND Directory <> 0) then
  138.       Search := Search( subdir+SR.name, searchfile );
  139.     FindNext( SR );
  140.   end;
  141.  
  142.   If (Length( searchfile ) > 0) and (pos( '.', searchfile ) > 0) then
  143.     Delete( searchfile, pos( '.', searchfile ), Length( searchfile ) );
  144.  
  145.   If FoundCOM then
  146.     Search := COMloc+searchfile+'.COM'
  147.   Else If FoundEXE then
  148.     Search := EXEloc+searchfile+'.EXE'
  149.   Else If FoundBAT then
  150.     Search := BATloc+searchfile+'.BAT'
  151.   Else
  152.     Search := '';
  153.  
  154. end;  { Search }
  155.  
  156. { ----------------------------------------------- GetComSpec ------------ }
  157.  
  158. function GetComSpec : string;  {-Return the environment variable value}
  159.  
  160. const
  161.   ComSpec = 'COMSPEC=';
  162.  
  163. type
  164.   Env = array[0..32767] of Char;
  165.  
  166. var
  167.   EnvPtr : ^Env;
  168.   EnvStr : string;
  169.   Found  : Boolean;
  170.   Len, I : Integer;
  171.  
  172. begin {GetComSpec}
  173.   GetComSpec := '';
  174.   EnvPtr := Ptr(MemW[PrefixSeg:$2C], 0);
  175.   I := 0;
  176.   Len := Length(ComSpec);
  177.   Found := False;
  178.   EnvStr := '';
  179.   repeat
  180.     if EnvPtr^[I] = #0 then begin
  181.       if EnvPtr^[Succ(I)] = #0 then
  182.         Found := True;
  183.  
  184.       if Copy(EnvStr, 1, Len) = ComSpec then begin
  185.         GetComSpec := Copy(EnvStr, Succ(Len), 255);
  186.         Found := True;
  187.         end
  188.       else
  189.         EnvStr := '';
  190.     end
  191.     else
  192.       EnvStr := EnvStr+EnvPtr^[I];
  193.     Inc(I);
  194.   until Found;
  195. end; {GetComSpec}
  196.  
  197. { ----------------------------------------------- MyExitProc ------------ }
  198.  
  199. {$F+}
  200. procedure MyExitProc;
  201. begin
  202.   ExitProc := OldExitProc;
  203.   If ExitCode = 202 then begin
  204.     Writeln( 'ERROR: Subdirectories nested too deeply.' );
  205.     HALT( 3 );
  206.   end
  207. end;
  208. {$F-}
  209.  
  210. { ----------------------------------------------- MAIN ------------------ }
  211.  
  212. BEGIN { RUN main program }
  213.  
  214.   { save exit proc's address }
  215.   OldExitProc := ExitProc;
  216.   ExitProc := @MyExitProc;
  217.  
  218.   { make sure we have a program to run }
  219.   If ParamCount > 0 Then begin
  220.  
  221.     { make sure we have a COMMAND shell to run }
  222.     If Exists( GetComSpec ) Then begin
  223.  
  224.       { Get Current Directory }
  225.       GetDir( 0, CurDir );
  226.       If IOresult <> 0 then
  227.         CurDir := '';
  228.  
  229.       { Get Program Name }
  230.       ProgName := Caps( ParamStr( 1 ) );
  231.  
  232.       { get drive identifier, if any }
  233.       If pos( ':', ProgName ) > 1 Then
  234.         Drive := Copy( ProgName, pos( ':', ProgName )-1, 2 )
  235.       Else begin
  236.         GetDir( 0, Drive );
  237.         If IOresult = 0 Then
  238.           Drive := copy( Drive, 1, 2 )
  239.         Else
  240.           Drive := '';
  241.       end;
  242.  
  243.       { now strip the drive identifier }
  244.       While (pos( ':', ProgName ) > 0) do
  245.         delete( ProgName, 1, pos( ':', ProgName ) );
  246.  
  247.       { get subdir identifier, if any }
  248.       SubDir := ProgName;
  249.       While (Length( SubDir ) > 0) and (SubDir[Length( SubDir )] <> '\') do
  250.         Delete( SubDir, Length( SubDir ), 1 );
  251.  
  252.       { strip directory identifiers }
  253.       While (pos( '\', ProgName ) > 0) do
  254.         delete( ProgName, 1, pos( '\', ProgName ) );
  255.  
  256.       { get file name extension, if any }
  257.       If pos( '.', ProgName ) > 0 then begin
  258.         Ext := Copy( ProgName, pos( '.', ProgName ), 4 );
  259.         If (Ext <> '.COM') and (Ext <> '.EXE') and (Ext <> '.BAT') then
  260.           Ext := '.???';
  261.  
  262.         { strip extension }
  263.         While pos( '.', ProgName ) > 0 do
  264.           Delete( ProgName, pos( '.', ProgName ), Length( ProgName ) );
  265.         end
  266.       Else begin
  267.         Ext := '.???';
  268.       End;
  269.  
  270.       { First, see if the program is where we think it is }
  271.       If Exists( Drive+SubDir+ProgName+Ext ) then
  272.         ProgName := Drive+SubDir+ProgName+Ext
  273.       Else If Exists( Drive+SubDir+ProgName+'.COM' ) then
  274.         ProgName := Drive+SubDir+ProgName+'.COM'
  275.       Else If Exists( Drive+SubDir+ProgName+'.EXE' ) then
  276.         ProgName := Drive+SubDir+ProgName+'.EXE'
  277.       Else If Exists( Drive+SubDir+ProgName+'.BAT' ) then
  278.         ProgName := Drive+SubDir+ProgName+'.BAT'
  279.       Else begin
  280.         ProgName := ProgName + '.???';
  281.  
  282.         { initialize our "find" variables for Search }
  283.         FoundCOM := FALSE;
  284.         FoundEXE := FALSE;
  285.         FoundBAT := FALSE;
  286.  
  287.         TempName := Search( Drive, ProgName );
  288.         If Length( TempName ) > 0 then
  289.           ProgName := TempName;
  290.       End;
  291.  
  292.       { Verify that the program exists }
  293.       If Exists( ProgName ) Then begin
  294.  
  295.         { Build Command Line to pass to program }
  296.         Command := '';
  297.         For i := 2 To ParamCount Do
  298.           Command := Command+' '+ParamStr(i);
  299.  
  300.         { get subdir identifier, if any }
  301.         SubDir := ProgName;
  302.         While (Length( SubDir ) > 0) and (SubDir[Length( SubDir )] <> '\')
  303.                                      and (SubDir[Length( SubDir )] <> ':') do
  304.           Delete( SubDir, Length( SubDir ), 1 );
  305.         If (Length( SubDir ) > 3) and (SubDir[Length( SubDir )] = '\') then
  306.           Delete( SubDir, Length( SubDir ), 1 );
  307.  
  308.         { change to the proper directory }
  309.         ChDir( SubDir );
  310.         If IOresult <> 0 Then begin
  311.           Writeln( 'Invalid Subdirectory: ',SubDir );
  312.           HALT( 1 );
  313.         End;
  314.  
  315.         { Run the program }
  316.         Writeln( 'Running ',ProgName,Command );
  317.         Exec( GetComSpec,'/c '+ProgName+Command );
  318.         Case DOSerror of
  319.           0 : { do nothing } ;
  320.           2 : Writeln( 'Could Not Find ', GetComSpec );
  321.           8 : Writeln( 'Not Enough Memory' );
  322.         Else
  323.               Writeln( 'DOS Error' );
  324.         End; { Case }
  325.  
  326.         { change back to the proper directory }
  327.         ChDir( CurDir );
  328.         If IOresult <> 0 Then begin
  329.           Writeln( 'Invalid Subdirectory: ',CurDir );
  330.           HALT( 1 );
  331.         End;
  332.  
  333.         end
  334.       Else begin
  335.         Writeln( 'Could not find ',Caps(ParamStr( 1 )) );
  336.         HALT( 1 );
  337.       End
  338.       end
  339.     Else begin
  340.       Writeln( 'Could not find ', GetComSpec );
  341.       HALT( 2 );
  342.     End
  343.     end
  344.   Else begin
  345.     Writeln( 'Syntax:  RUN program          --  finds program and runs it' );
  346.     Writeln( '         RUN d:program        --  d: is the drive name' );
  347.     Writeln( '         RUN \subdir\program  --  \subdir\ is a subdirectory' );
  348.     Writeln( '         RUN program.exe      --  run the program with .EXE extension' );
  349.     Writeln( '         RUN program cmdline  --  run the program and pass the' );
  350.     Writeln( '                                  cmdline to the program, as well' );
  351.     HALT( 1 );
  352.   End;
  353.  
  354. END.  { RUN main program }
  355.